home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / codeWarrior.tcl < prev    next >
Text File  |  1996-01-26  |  11KB  |  408 lines
  1. #=== nowrap =====================================================================
  2. #
  3. #             CodeWarrior Interaction
  4. #
  5. # Metrowerks currently has an incomplete appleevent interface. 
  6. # Apple events can be used to direct CodeWarrior to compile
  7. # or add individual files, make the project, etc. However, 
  8. # there is currently no provision to report specific errors
  9. # back to the controller.
  10. #
  11. #================================================================================
  12.  
  13. proc cwarriorMenu {} {}
  14.  
  15.  
  16. menu -n "$cwarriorMenu" -p codeWarriorProc {
  17.     "help"
  18.     "/-<UswitchTo"
  19.     {menu -n werksFlags -p werksProc {
  20.         "debugger"
  21.         "switchWhenCompiling"
  22.     }}
  23.     "createFileset"
  24.     "(-"
  25.     "addFile"
  26.     "/K<Ucompile"
  27.     "compileFiles"
  28.     "checkSyntax"
  29.     "precompile╔"
  30.     "(-"
  31.     "/U<Uupdate"
  32.     "/M<Umake"
  33.     "(-"
  34.     "/D<UgotoDebugger"
  35.     "/B<UsetBreakpoint"
  36.     "clearBreakpoint"
  37.     "/J<UshowSource"
  38.     "(-"
  39.     "/N<UnextError"
  40.     "/R<Urun"
  41. }
  42.  
  43. if {![info exists cwdebugger]}     {set cwdebugger     0}
  44. if {![info exists cwswitchWhenCompiling]}     {set cwswitchWhenCompiling 1}
  45. markMenuItem werksFlags debugger $cwdebugger
  46. markMenuItem werksFlags switchWhenCompiling $cwswitchWhenCompiling
  47.  
  48. proc cwhelp {} {
  49.     global HOME
  50.     edit -r "$HOME:Help:CodeWarrior"
  51. }
  52.     
  53. proc werksProc {menu item} {
  54.     global cw$item modifiedVars
  55.     
  56.     set cw$item [expr -1 * ([set cw$item] - 1)]
  57.     markMenuItem werksFlags $item [set cw$item]
  58.     lappend modifiedVars cw$item
  59. }
  60.  
  61.  
  62.  
  63. set CWCLASS        MMPR
  64. set CDCLASS        MWDB
  65.  
  66.  
  67. proc cwnextError {} {
  68.     nextMatch "*Compiler Errors*"
  69. }
  70.  
  71. proc dispErr {{win "* Compiler Errors *"}} {
  72.     if {[string length $win]} {
  73.         set text [getText -w $win [getPos -w $win] [selEnd -w $win]]
  74.         if {[regexp {(Line.*)░} $text dummy sub]} {
  75.             message "$sub"
  76.         }
  77.     }
  78. }
  79.         
  80.  
  81. proc codeWarriorProc {menu item} {
  82.     cw$item
  83. }
  84.     
  85. proc cwswitchTo {} {
  86.     global CODEWarrior
  87.     checkCw
  88.     switchTo $CODEWarrior
  89. }
  90.  
  91. proc cwmake {} {killCwErrors; cwDo Make}
  92. proc cwupdate {} {cwDo UpdP}
  93.  
  94. proc cwDo {param} {
  95.     global CODEWarrior CWCLASS ALPHA
  96.     checkCw
  97.     switchTo $CODEWarrior
  98.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(╟01╚)"]]]} {
  99.         warriorErrors $res
  100.     }
  101. }
  102.  
  103. proc cwrun {} {
  104.     global CODEWarrior CWCLASS ALPHA cwdebugger
  105.     checkCw
  106.     killCwErrors
  107.     set bug $cwdebugger
  108.     switchTo $CODEWarrior
  109.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(╟01╚)" DeBg $bug]]]} {
  110.         warriorErrors $res
  111.     }
  112. }
  113.  
  114.  
  115. proc cwprecompile {} {
  116.     global CODEWarrior CWCLASS res
  117.     checkCw
  118.     set fname [lindex [winNames -f] 0]
  119.     set targ [putfile "Precompile target:"]
  120.     switchTo $CODEWarrior
  121.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(╟01╚)" Targ [makeAlis $targ]]]] > 40} {
  122.         warriorErrors $res
  123.     } else {
  124.         if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  125.             message "Error number: $errno"
  126.         }
  127.     }
  128. }
  129.  
  130.  
  131. proc cwaddFile {} {
  132.     global CODEWarrior CWCLASS
  133.     checkCw
  134.     switchTo $CODEWarrior
  135.     set fname [lindex [winNames -f] 0]
  136.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  137. }
  138.  
  139. proc cwcheckSyntax {} {
  140.     global CODEWarrior CWCLASS res
  141.     checkCw
  142. #    switchTo $CODEWarrior
  143.     set fname [lindex [winNames -f] 0]
  144.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(╟} [coerce TEXT $fname -x alis] {╚)]}] "Errs" "bool(╟01╚)"]]] > 40} {
  145.         warriorErrors $res
  146.     }
  147. }
  148.  
  149.  
  150. proc killCwErrors {} {
  151.     set wins [winNames]
  152.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  153.         set name [lindex $wins $res]
  154.         bringToFront $name
  155.         killWindow
  156.     }
  157. }    
  158.  
  159.  
  160. proc cwcompile {} {
  161.     global CODEWarrior CWCLASS res ALPHA cwswitchWhenCompiling
  162.     save
  163.     checkCw
  164.     set fname [lindex [winNames -f] 0]
  165.     killCwErrors
  166.     if {$cwswitchWhenCompiling} {
  167.         switchTo $CODEWarrior
  168.     }
  169.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(╟01╚)"]]] > 40} {
  170.         warriorErrors $res
  171.     }
  172.     switchTo $ALPHA
  173. }
  174.  
  175.  
  176. proc cwcompileFiles {} {
  177.     global CODEWarrior CWCLASS res ALPHA winModes
  178.     saveAll
  179.     checkCw
  180.     set files {}
  181.     set wins [winNames -f]
  182.     set md $winModes([lindex $wins 0])
  183.     foreach w $wins {
  184.         if {$md == $winModes($w)} {
  185.             lappend files $w
  186.         }
  187.     }
  188.     killCwErrors
  189.     switchTo $CODEWarrior
  190.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [eval makeAlises $files] "Errs" "bool(╟01╚)"]]] > 40} {
  191.         warriorErrors $res
  192.     }
  193.     switchTo $ALPHA
  194. }
  195.  
  196.  
  197. proc cwGetFiles {} {
  198.     global CODEWarrior CWCLASS
  199.     checkCw
  200.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  201.     regexp {\[(.*)\]} $res dummy segs
  202.     regsub -all {, Seg} $segs {Ñ} segs
  203.     set ind 1
  204.     foreach seg [split $segs {Ñ}] {
  205.         regexp {NumF:([0-9]+)} $seg dummy num
  206.         
  207.         while {$num > 0} {
  208.             set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  209.             if {[regexp {FTxt} $res]} {
  210.                 regexp {╟(.*)╚} $res dummy spec
  211.                 set f [specToPathName $spec]
  212.                 message $f
  213.                 lappend files $f
  214.             }
  215.             incr num -1
  216.         }
  217.         incr ind
  218.     }
  219.     return $files
  220. }
  221.  
  222. proc createWarriorFileset {} {
  223.     cwcreateFileset
  224. }
  225.  
  226.  
  227. proc cwcreateFileset {} {
  228.     global fileSets
  229.     global currFileSet
  230.     
  231.     set name [prompt "Fileset name? " "CodeWarrior"]
  232.     set fileSets($name) [lsort -command sortByTail [cwGetFiles]]
  233.     addMenuItem -m choose $name
  234.     set currFileSet $name
  235.  
  236.     if {[askyesno "Save project fileset?"] == "yes"} {
  237.         addArrDef fileSets $name  $fileSets($name)
  238.     }
  239.     rebuildFilesetMenu
  240. }
  241.  
  242.  
  243. # the error reply from CodeWarrior looks like this
  244. # [ErrM{ErrT:ErCW, ErrS:╥function declaration hides inherited virtual function╙, file:fss (╟FFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000╚), ErrL:64}, ...]
  245. #
  246. # ErrT is the error type parameter
  247. #     ErCW indicates a warning
  248. #     ErCE indicates an error
  249. # Improvements by jdunning@cs.Princeton.EDU (John Dunning)
  250. proc warriorErrors {res} {    
  251.     global winModes tileLeft tileTop tileWidth errorHeight
  252.  
  253.     if {[regexp {\[.*\]} $res res]} {
  254.             # trim off the outside brackets
  255.         set res [string trim $res {[]}]
  256.         
  257.             # replace all the returns in the error list with spaces.  this is 
  258.             # necessary because CW 7.0 can return multi-line error messages,
  259.             # which aren't processed correctly by this function.
  260.         regsub -all "\r" $res " " res
  261.         
  262.             # delete the first ErrM, and replace the remaining ones (and the preceeding commas)
  263.             # with returns
  264.         regsub {ErrM} $res "" res
  265.         regsub -all {, ErrM} $res "\r" res
  266.         
  267.         set text ""
  268.         set errors 0
  269.         set warnings 0
  270.         set messages 0
  271.         set link 0
  272.         
  273.             # split the string into separate lines, one error per line.  only process
  274.             # process the first 101 errors
  275.         foreach err [lrange [split $res "\r"] 0 100] {
  276.                 # the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
  277.                 # error and whether it's an error (E) or a warning (W).  stick the rest of
  278.                 # the error message back into err.
  279.             if {[regexp {ErrT:Er(.)(.),[ \t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
  280.                 if {$errorOrWarning == "E"} {
  281.                         # mark actual errors with a bullet
  282.                     append text " Ñ "
  283.                     incr errors
  284.                 } else {
  285.                         # mark warnings with a delta
  286.                     append text " ╞ "
  287.                     incr warnings
  288.                 }
  289.                 
  290.                 if {$compileOrLink == "C"} {
  291.                         # we have a compile error, so strip out the error message, the filespec
  292.                         # and the line number
  293.                     if {[regexp {ErrS:╥(.*)╙.*╟(.*)╚.*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
  294.                             # conver the filespec that was returned in the apple event into a pathname
  295.                             # so we can display it
  296.                         set pathName [specToPathName $fileSpec]
  297.                     
  298.                             # append the file name (the tail of the pathname), the line number,
  299.                             # the error string, lots of tabs, and then the full pathname
  300.                         append text "\"[file tail $pathName]\"\t; Line $lineNumber: $errorString\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t░$pathName\r"
  301.                     }
  302.                 } else {
  303.                         # we got a link error
  304.                     set link 1
  305.                     
  306.                         # just strip out the error message.  the file the error occurs in doesn't 
  307.                         # seem to get included in the event
  308.                     if {[regexp {ErrS:╥(.*)╙} $err unused errorString]} {
  309.                             # append the error message
  310.                         append text "$errorString\r"
  311.                     }
  312.                 }
  313.             } elseif {[regexp {╥([^:]*): (.*)╙} $err unused fileName message]} {
  314.                     # we got some sort of message, so strip out the associated file name and 
  315.                     # the message.  I'm not sure if CodeWarrior still returns anything of this form.
  316.                 append text "\"$fileName\" ; $message\r"
  317.                 incr messages
  318.             }
  319.         }
  320.  
  321.         set wins [winNames]
  322.         if {$errors == 0 && $warnings == 0 && $messages == 0} {
  323.             global killCompilerErrors
  324.             set killCompilerErrors 1
  325.             return
  326.         }
  327.         
  328.         new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight
  329.         changeMode [set winModes([lindex [winNames] 0]) Brws]
  330.  
  331.         if {$link} {
  332.             insertText "(Link: $errors errors, $warnings warnings, $messages messages)\r-----\r$text"
  333.         } else {
  334.             insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)\r-----\r$text"
  335.         }
  336.  
  337.         display 0
  338.         goto 0
  339.         downBrowse
  340.         setWinInfo dirty 0
  341.         setWinInfo read-only 1
  342.     }
  343. }
  344.  
  345.  
  346.  
  347. proc cwTouch {} {
  348.     global CODEWarrior CWCLASS
  349.     checkCw
  350.     switchTo $CODEWarrior
  351.     set fname [lindex [winNames -f] 0]
  352.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  353. }
  354.     
  355. proc checkCw {} {
  356.     global CODEWarrior modifiedVars cwSig cwPath
  357.     set CODEWarrior [checkRunning "CodeWarrior Compiler" $cwSig cwPath]
  358.     set sig [getFileSig $cwPath]
  359.     if {$sig != $cwSig} {
  360.         lappend modifiedVars cwSig
  361.         set cwSig $sig
  362.     }
  363. }
  364.  
  365. proc checkCwDebug {} {
  366.     global CODEDEBUGGER cwdSig cdPath modifiedVars
  367.     set CODEDEBUGGER [checkRunning "CodeWarrior Debugger" $cwdSig cdPath]
  368.     set sig [getFileSig $cdPath]
  369.     if {$sig != $cwdSig} {
  370.         lappend modifiedVars cwdSig
  371.         set cwdSig $sig
  372.     }
  373. }
  374.  
  375. proc cwgotoDebugger {} {
  376.     global CODEDEBUGGER
  377.     checkCwDebug
  378.     switchTo $CODEDEBUGGER
  379. }
  380.  
  381. proc cwsetBreakpoint {} {
  382.     global CODEDEBUGGER CDCLASS res
  383.     checkCwDebug
  384.     switchTo $CODEDEBUGGER
  385.     set fname [lindex [winNames -f] 0]
  386.     set ln [lindex [posToRowCol [getPos]] 0]
  387.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  388. }
  389.  
  390. proc cwclearBreakpoint {} {
  391.     global CODEDEBUGGER CDCLASS res
  392.     checkCwDebug
  393.     switchTo $CODEDEBUGGER
  394.     set fname [lindex [winNames -f] 0]
  395.     set ln [lindex [posToRowCol [getPos]] 0]
  396.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  397. }
  398.  
  399.  
  400. proc cwshowSource {} {
  401.     global CODEDEBUGGER CDCLASS res
  402.     checkCwDebug
  403.     switchTo $CODEDEBUGGER
  404.     set fname [lindex [winNames -f] 0]
  405.     set ln [lindex [posToRowCol [getPos]] 0]
  406.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  407. }
  408. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"